PSJCLOZ ; DAL/RJS - INPATIENT CLOZAPINE ORDER CHECK ; 1/8/16 6:50pm
 ;;5.0;INPATIENT MEDICATIONS ;**327**;01 DEC 15;
 ;
CLOZ(DFN,DRUG) ;
 ; DFN MUST BE SET TO PATIENT IEN
 ; DRUG MUST BE SET TO DRUG IEN
 I '$G(DFN)!('$G(DRUG)) S ANQX=0 Q
 D PROVCHK($G(PSGPR)) Q:ANQX
 N RTN
 S RTN=$P($G(^PSDRUG(DRUG,"CLOZ1")),U)
 D:$L(RTN) ^@RTN
 Q
 ;
PROVCHK(PROV) ;
 N PSJQUIT
 ;
 S (ANQX,PSJQUIT)=0
 I $G(PROV) D
 .I '$L($$DEA^XUSER(,PROV)) D
 ..S (ANQX,PSJQUIT)=1
  ..W !," ",!,?5,"*** Provider must have a DEA# or VA# to write prescriptions for this drug."
 .Q:PSJQUIT
 .I '$D(^XUSEC("YSCL AUTHORIZED",PROV)) D
 ..S (ANQX,PSJQUIT)=1
 ..W !," ",!,?5,"*** Provider must hold YSCL AUTHORIZED key to write prescriptions for clozapine."
 Q
BEFQUIT ;
 Q:'$G(QOAA)
 N QODS,QORF,ORMAX,ORCLPAT
 S QODS=$O(^ORD(101.41,"AB","OR GTX DAYS SUPPLY","")) Q:QODS'>0
 S QODS=$O(^ORD(101.41,ORX,6,"D",QODS,"")) Q:QOIEN'>0
 S QODS=$G(^ORD(101.41,ORX,6,QODS,1))
 S QORF=$O(^ORD(101.41,"AB","OR GTX REFILLS","")) Q:QORF'>0
 S QORF=$O(^ORD(101.41,ORX,6,"D",QORF,"")) Q:QOIEN'>0
 S QORF=$G(^ORD(101.41,ORX,6,QORF,1))
 S QORF=QORF+1
 S ORCLPAT=$P(ORYS,U,7)
 S ORMAX=$S(ORYS="M":28,ORYS="B":14,ORYS="W":7,1:90)
 I QORF*QODS>ORMAX D
 .K ORY
 .S ORY=1_U_ORCLOZ
 .W !,?5,"Problem Ordering Clozapine Related Medication"_U_ORCLOZ
 .W !,?5,"*** This patient is only allowed an order with a maximum Days Supply of "_ORMAX_"."
 .W !,?5,"This includes the amounts added by any refills entered in with the order also."
 Q
OVERRIDE ;
 I '$G(^XUSEC("PSOLOCKCLOZ",PROV)) D  Q 1
 .N Y
 .W !," ",!,?5,"*** You are not authorized to override Clozapine orders.",!," "
 .K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR W @IOF
 Q
PSJFILE(DFN) ;
 S PSJCLPAT=DFN
 I $D(ANQDATA) S PSJPROV=$P(ANQDATA,"^",5),PSJ1PH=$P(ANQDATA,"^"),PSJ2PH=$P(ANQDATA,"^",2),PSJREASN=$P(ANQDATA,"^",3),PSJREMRK=$P(ANQDATA,"^",4) D NOW^%DTC G:$D(^PS(53,8,"B",%)) PSJFILE D
 . I $D(ORO) S PSJPROV=$P(ORO,"^",4),PSJORN=$P(ORO,"^",1),PSJORDER("PSJORN")=PSJORN
 . K DD,DO S DIC="^PS(53.8,",DIC(0)="L",DLAYGO=53.8,X=%
 . D FILE^DICN K DIC,DLAYGO,DD,DO,DA,DR
 . N PS538 S (PS538,DA)=+Y,DIE="^PS(53.8,",DR="1////"_PSJORDER("PSJORN")_";3////"_PSJPROV_";2////"_PSJ1PH_";4////"_PSJREASN_";5////"_PSJREMRK_";6////"_PSJ2PH
 . D ^DIE K DIE,DA,DR
 . K ANQDATA,X,Y,%,ANQREM
 . W !,"THE OVERRIDEN ORDER IS COMPLETE",!
 . D ALERT
 Q
ALERT ; send an alert to the three approving team members
 S XQADATA=PSCLPAT ;
 S PSOLAST4=$E($P($G(^DPT(PSCLPAT,0)),"^",9),6,9)
 S XQAARCH=1
 S XQAFLG="D"
 S XQA(PSJ1PH)="",XQA(PSJ2PH)="",XQA(PSJPROV)=""
 D NOW^%DTC S Y=% D DD^%DT S PSCDATE=Y
 S XQAMSG=$$GET1^DIQ(2,PSCLPAT,.01)_" ("_PSOLAST4_")"_": CLOZAPINE OVERRIDE RX PROCESSED  :"_PSCDATE
 S XQAID="PSI"_","_PSCLPAT
 D PHGRP^PSOCLO1 M XQA=XMY D SETUP^XQALERT
 W !!,"OVERRIDE ALERTS HAVE BEEN SENT TO THE APPROVING TEAM MEMBERS",!!
 Q
 ;
READ ;
 ;W !,"Do you concurr with the requested override for "_CLOZPAT
 S DIR("A")="Do you concurr with the requested override for "_CLOZPAT,DIR(0)="Y",DIR("B")="N" D ^DIR G END:$D(DIRUT) K DIR D:'Y!($D(DIRUT)) END
 Q
END ;
 K DIRUT,DIROUT,DIR
 Q 